home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / nexttsrc.lha / nexttsources / sources / comp / assembler / vaxam.t < prev    next >
Encoding:
Text File  |  1988-02-05  |  7.9 KB  |  250 lines
  1. (herald vaxam 
  2.         (env t (assembler as_open)))
  3.  
  4. ;;; Copyright (c) 1985 Yale University
  5. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
  6. ;;; This material was developed by the T Project at the Yale University Computer 
  7. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  8. ;;; and to use it for any purpose is granted, subject to the following restric-
  9. ;;; tions and understandings.
  10. ;;; 1. Any copy made of this software must include this copyright notice in full.
  11. ;;; 2. Users of this software agree to make their best efforts (a) to return
  12. ;;;    to the T Project at Yale any improvements or extensions that they make,
  13. ;;;    so that these may be included in future releases; and (b) to inform
  14. ;;;    the T Project of noteworthy uses of this software.
  15. ;;; 3. All materials developed as a consequence of the use of this software
  16. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  17. ;;;    of acknowledging credit in academic research.
  18. ;;; 4. Yale has made no warrantee or representation that the operation of
  19. ;;;    this software will be error-free, and Yale is under no obligation to
  20. ;;;    provide any services, by way of maintenance, update, or otherwise.
  21. ;;; 5. In conjunction with products arising from the use of this material,
  22. ;;;    there shall be no use of the name of the Yale University nor of any
  23. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  24. ;;;    without prior written consent from Yale in each case.
  25. ;;;
  26.  
  27. (define *vax-register-names* 
  28.                  '#( "s0" "s1" "s2" "s3"  "p"    "a1" "a2" "a3" 
  29.                      "a4" "an" "tp" "nil" "task" "fp" "sp" "pc" ))
  30.  
  31. (define-integrable (vax-register-name rn)
  32.     (vref *vax-register-names* rn))
  33.  
  34. (define (r regnum)
  35.   (vref *register-fgs* regnum))
  36.  
  37. (define-fg (%r regnum)
  38.   (printer "~a" (vax-register-name (? regnum)))
  39.   (f u 4 5)
  40.   (f u 4 regnum))
  41.  
  42. (lset *register-fgs* (make-vector 16))
  43.  
  44. (do ((i 0 (fx+ i 1)))
  45.     ((fx> i 15)
  46.      'done)
  47.   (set (vref *register-fgs* i) (%r i)))
  48.  
  49. (define-fg (@r regnum)
  50.   (printer "(~a)" (vax-register-name (? regnum)))
  51.   (f u 4 6)
  52.   (f u 4 regnum))
  53.  
  54. (define-fg (@-r regnum)
  55.   (printer "-(~a)" (vax-register-name (? regnum)))
  56.   (f u 4 7)
  57.   (f u 4 regnum))
  58.  
  59. (define-fg (@r+ regnum)
  60.   (printer "(~a)+" (vax-register-name (? regnum)))
  61.   (f u 4 8)
  62.   (f u 4 regnum))
  63.  
  64. (define-fg (*@r+ regnum)
  65.   (printer "*(~a)+" (vax-register-name (? regnum)))
  66.   (f u 4 9)
  67.   (f u 4 regnum))
  68.  
  69. (define-fg (s^& u6bit)
  70.   (printer "s^$~s" (? u6bit))
  71.   (f u 2 0)
  72.   (f u 6 u6bit))
  73.  
  74. (define (d@r regnum displ)
  75.   (cond ((fx= displ 0) (@r regnum))
  76.         (else (%d@r regnum displ))))
  77.  
  78. (define-fg (%d@r regnum displ)
  79.   (printer "~s(~a)" (? displ) (vax-register-name (? regnum)))
  80.   (f u 4 (d@r-mode (? displ)))
  81.   (f u 4 regnum)
  82.   (v s (8 16 32) displ))
  83.  
  84. (define-fg (*d@r regnum displ)
  85.   (printer "*~s(~a)" (? displ) (vax-register-name (? regnum)))
  86.   (f u 4 (*d@r-mode (? displ)))
  87.   (f u 4 regnum)
  88.   (v s (8 16 32) displ))
  89.  
  90. (define-fg (index indexable regnum)
  91.   (printer "~g[~a]" (? indexable) (vax-register-name (? regnum)))
  92.   (f u 4 4)
  93.   (f u 4 regnum)
  94.   (fg indexable))
  95.  
  96. (define-fg (absolute location) 
  97.   (printer "*$~s" (? location))
  98.   (f u 8 #x9F)
  99.   (f u 32 location))
  100.  
  101. (define (d@r-mode displ)
  102.   (cond ((8bit? displ) #xA)
  103.         ((16bit? displ) #xC)
  104.         (else #xE)))
  105.  
  106. (define (d@r-mode-given-width width)
  107.   (cond ((fx<= width 8) #xA)
  108.         ((fx<= width 16) #xC)
  109.         (else #xE)))
  110.  
  111. (define (*d@r-mode displ)
  112.   (cond ((8bit? displ) #xB)
  113.         ((16bit? displ) #xD)
  114.         (else #xF)))
  115.  
  116. (define (*d@r-mode-given-width width)
  117.   (cond ((fx<= width 8) #xB)
  118.         ((fx<= width 16) #xD)
  119.         (else #xF)))
  120.  
  121. (define-fg (d@pc tag)
  122.   (printer "~g" (? tag))
  123.   (local dot width displ)
  124.   (f u 4 (d@r-mode-given-width (? width)))
  125.   (f u 4 #xF)
  126.   (depending-on (disp dot tag)
  127.                 (choose-a-pcrel (width 8) displ) 
  128.                 (displacement-fg (? width) (? displ)))
  129.   (mark dot))
  130.  
  131. (define (choose-a-pcrel current-width displ)
  132.   (cond ((fx< displ 0)
  133.          (let ((displ (fx+ displ current-width)))
  134.             (cond ((8bit-in-bits? (fx- displ 8))  (return 8 (fx- displ 8)))
  135.                   ((16bit-in-bits? (fx- displ 16)) (return 16 (fx- displ 16)))
  136.                   (else (return 32 (fx- displ 32))))))
  137.         (else
  138.          (cond ((8bit-in-bits? displ) (return 8 displ))
  139.                ((16bit-in-bits? displ) (return 16 displ))
  140.                (else (return 32 displ))))))
  141.  
  142. (define-fg (displacement-fg width displ)
  143.     (f s width (fixnum-ashr (? displ) 3)))
  144.  
  145. ;;; Immediates
  146.  
  147. (define ($ x)
  148.   (cond ((and (fixnum? x) (fx>= x 0) (fx< x 64))
  149.          (s^& x))
  150.         (else
  151.          (& x))))
  152.             
  153. (define-fg (& value) 
  154.   (context (general size type access))
  155.   (printer "$~s" (? value))
  156.   (fg (vax-immediate (? value) (? size) (? type))))
  157.  
  158. (define (vax-immediate value size type)
  159.   (case type
  160.     ((byte word long quad) 
  161.      (vax-immediate-integer value size))
  162.     ((f-float d-float)
  163.      (cond ((vax-short-floating-operand value)
  164.             => identity)
  165.            ((eq? type 'd-float)
  166.             (vax-immediate-fg (vax-d-floating-bits value)))
  167.            (else
  168.             (vax-immediate-fg (vax-f-floating-bits value)))))
  169.     (else
  170.      (bug "cannot emit a type ~s operand" type))))
  171.                               
  172. (define-fg (vax-immediate-integer value size)
  173.     (f u 8 #x8F)
  174.     (f s size value))
  175.                               
  176. (define-fg (vax-immediate-fg bits)
  177.     (f u 8 #x8F)
  178.     (fg bits))
  179.  
  180. ;;; Floating point bit fields.
  181.  
  182. ;;; <n,s> means bit field of length s beginning at bit n of the first
  183. ;;; WORD (not longword)
  184. ;;;                    sign      exponent   MSB       fraction
  185. ;;; Apollo IEEE flonum <15,1>    <4,11>     hidden    <0,4>+next 3 words
  186. ;;; VAX11 flonum (D)   <15,1>    <7,8>      hidden    <0,7>+next 3 words
  187. ;;; Apollo IEEE flonum - binary point follows  hidden MSB, 53 bits of
  188. ;;;     precision, if hidden bit is included
  189. ;;; VAX11 flonum (D)   - binary point precedes hidden MSB, 56 bits of
  190. ;;;     precision, if hidden bit is included 
  191.  
  192. ;;; On the vax
  193. ;;;   (integer-decode-float 1.0 list) =>
  194. ;;;     (36028797018963968 -55)
  195. ;;;     actual stored exponent is 129
  196.  
  197. ;;; On the Apollo
  198. ;;;   (integer-decode-float 1.0 list)
  199. ;;;     (4503599627370496 -52)
  200. ;;;     actual stored exponent is 1023
  201.        
  202.  
  203. (define-constant %%vax-d-size 56)
  204. (define-constant %%vax-d-excess 128)
  205. (define-constant %%vax-f-size 24)
  206. (define-constant %%vax-f-excess 128)
  207.  
  208. (import t-implementation-env %ash)
  209.  
  210. (define (vax-short-floating-operand flonum)
  211.    (receive (sign mantissa exponent)
  212.             (normalized-float-parts flonum %%vax-f-size %%vax-f-excess nil)
  213.       (cond ((and (fx= sign 0)
  214.                   (fx>= exponent 128)
  215.                   (fx<  exponent 136))
  216.              (let* ((shift (fx- %%vax-f-size 4))
  217.                     (short-m (%ash mantissa (fixnum-negate shift)))
  218.                     (short-e (fx- exponent 128)))
  219.                (cond ((= mantissa (%ash short-m shift))
  220.                       (short-float-immediate-fg short-m short-e))
  221.                      (else nil))))
  222.             (else nil))))
  223.  
  224. (define-fg (short-float-immediate-fg m e)
  225.     (f u 2 0) (f u 3 e) (f u 3 m))
  226.  
  227. (define (vax-d-floating-bits flonum)
  228.    (receive (s nm ne)
  229.             (normalized-float-parts flonum %%vax-d-size %%vax-d-excess nil)
  230.       (vax-d-floating-fg flonum s nm ne)))
  231.  
  232. (define (vax-f-floating-bits flonum)
  233.    (receive (s nm ne)
  234.             (normalized-float-parts flonum %%vax-f-size %%vax-f-excess nil)
  235.       (vax-f-floating-fg flonum s nm ne)))
  236.  
  237. (define-data-fg (vax-d-floating-fg flonum s m e)
  238.     (printer ".d_float ~s" (? flonum))
  239.     (f u 1 s) (f u 8 e) (f u 7 (bignum-bit-field (? m) 48 7))
  240.     (f u 16 (bignum-bit-field (? m) 32 16))
  241.     (f u 16 (bignum-bit-field (? m) 16 16))
  242.     (f u 16 (bignum-bit-field (? m) 0  16)))
  243.  
  244. (define-data-fg (vax-f-floating-fg flonum s m e)
  245.     (printer ".f_float ~s" (? flonum))
  246.     (f u 1 s) (f u 8 e) (f u 7 (hacked-bit-field (? m) 16 7))
  247.     (f u 16 (hacked-bit-field (? m) 0 16)))
  248.  
  249.  
  250.